home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / 1997.ZIP / INPFLD14.ARC / INPFLD.INC < prev   
Text File  |  1987-09-21  |  17KB  |  366 lines
  1. { ===================================================================== }
  2. { INPFLD.INC - Get a field of characters. All attributes concerning     }
  3. {    the field are user-definable. InpFld was concieved from a routine  }
  4. {    contained in the Borland International Turbo Database Toolbox.     }
  5. {                                                                       }
  6. {    The following procedures are also contained in the package         }
  7. {    WINDOxx.ARC and are duplicated here for ease of use:               }
  8. {        DispLine   Set_Cursor                                          }
  9. {                                                                       }
  10. {     Author:   Michael Burton                                          }
  11. {               15540 Boot Hill Rd.                                     }
  12. {               Hayden Lake, ID 83835                                   }
  13. {               (208) 772-9347 (after 1800 PST)                         }
  14. {     Revision: 1.4                                                     }
  15. {     Date:     20 September 1987                                       }
  16. {                                                                       }
  17. {  Copyright (C) 1987 by Michael Burton                                 }
  18. {                                                                       }
  19. {  This is a 'Shareware' program.  If you find it to be of significant  }
  20. {  use to you, a $10 donation to the above address would be greatly     }
  21. {  appreciated.  This would also place you on our mailing list to keep  }
  22. {  you informed of upgrades to InpFld and of new programs.              }
  23. {                                                                       }
  24. { Modifications:                                                        }
  25. { DATE       Rev  Description                                           }
  26. { 16 Jun 87  1.0  Initial release                                       }
  27. { 02 Jul 87  1.1  Add right justified field option                      }
  28. { 31 Jul 87  1.2  Add filler character                                  }
  29. { 13 Aug 87  1.3  Add exit only if field full or Esc pressed            }
  30. { 20 Sep 87  1.4  Fix interrupt problem in DispLine                     }
  31. { ===================================================================== }
  32. Type
  33.    option_type = set of 0..7;
  34.    strg80 = string[80];
  35.    strg255 = string[255];
  36.    ifrec  = record case integer of
  37.                   1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  38.                   2: (al,ah,bl,bh,cl,ch,dl,dh: byte);
  39.                 end;
  40.  
  41. Const
  42.    IFCR   = 13;
  43.    IFESC  = 27;
  44.    IFCTLS = 19;
  45.    IFCTLD = 4;
  46.    IFCTLA = 1;
  47.    IFCTLF = 6;
  48.    IFCTLG = 7;
  49.    IFBKSP = 8;
  50.    IFCTBS = 127;
  51.    IFINS  = 338;
  52.    IFLARW = 331;
  53.    IFRARW = 333;
  54.    IFHOME = 327;
  55.    IFEND  = 335;
  56.    IFDEL  = 339;
  57.    IFTAB  = 9;
  58.    IFBTAB = 271;
  59.    IFUARW = 328;
  60.    IFDARW = 336;
  61.    IFCRAR = 372;
  62.    IFCLAR = 371;
  63.    IFCEND = 373;
  64.  
  65. { ===================================================================== }
  66. { DISPLINE - Display a string of characters on the CRT (with the same   }
  67. {            attributes)                                                }
  68. {           The row and column inputs are relative to zero and are      }
  69. {           also relative to the entire screen, not any open window.    }
  70. {                                                                       }
  71. {    Inputs:                                                            }
  72. {       colb      : byte;       Starting column  (0 - 79)               }
  73. {       rowb      : byte;       Starting row     (0 - 24)               }
  74. {       attrib    : byte;       Line attributes                         }
  75. {       fromstrng : string[80]; String to display                       }
  76. { ===================================================================== }
  77. Procedure DispLine(colb,rowb,attrib : byte; VAR fromstrng : strg80);
  78. Begin
  79.    Inline(
  80.       $1E/                    {           PUSH   DS               }
  81.       $8A/$86/rowb/           {           MOV    AL,rowb[BP]      }
  82.       $B3/$50/                {           MOV    BL,80            }
  83.       $F6/$E3/                {           MUL    BL               }
  84.       $2B/$DB/                {           SUB    BX,BX            }
  85.       $8A/$9E/colb/           {           MOV    BL,colb[BP]      }
  86.       $03/$C3/                {           ADD    AX,BX            }
  87.       $03/$C0/                {           ADD    AX,AX            }
  88.       $8B/$F8/                {           MOV    DI,AX            }
  89.       $8A/$BE/attrib/         {           MOV    BH,attrib[BP]    }
  90.       $C4/$B6/fromstrng/      {           LES    SI,fromstrng[BP] }
  91.       $2B/$C9/                {           SUB    CX,CX            }
  92.       $26/$8A/$0C/            {           MOV    CL,ES:[SI]       }
  93.       $2B/$C0/                {           ADD    AX,AX            }
  94.       $8E/$D8/                {           MOV    DS,AX            }
  95.       $A0/$49/$04/            {           MOV    AL,DS:[0449H]    }
  96.       $22/$C9/                {           AND    CL,CL            }
  97.       $74/$35/                {           JZ     DONE             }
  98.       $2C/$07/                {           SUB    AL,7             }
  99.       $74/$22/                {           JZ     MONO             }
  100.       $BA/$00/$B8/            {           MOV    DX,0B800H        }
  101.       $8E/$DA/                {           MOV    DS,DX            }
  102.       $BA/$DA/$03/            {           MOV    DX,03DAH         }
  103.       $46/                    { GETCHAR:  INC    SI               }
  104.       $26/$8A/$1C/            {           MOV    BL,ES:[SI]       }
  105.       $FA/                    {           CLI                     }
  106.       $EC/                    { TESTLOW:  IN     AL,DX            }
  107.       $A8/$01/                {           TEST   AL,1             }
  108.       $75/$FB/                {           JNZ    TESTLOW          }
  109.       $EC/                    { TESTHI:   IN     AL,DX            }
  110.       $A8/$01/                {           TEST   AL,1             }
  111.       $74/$FB/                {           JZ     TESTHI           }
  112.       $89/$1D/                {           MOV    DS:[DI],BX       }
  113.       $FB/                    {           STI                     }
  114.       $47/                    {           INC    DI               }
  115.       $47/                    {           INC    DI               }
  116.       $E2/$EA/                {           LOOP   GETCHAR          }
  117.       $2A/$C0/                {           SUB    AL,AL            }
  118.       $74/$0F/                {           JZ     DONE             }
  119.       $BA/$00/$B0/            { MONO:     MOV    DX,0B000H        }
  120.       $8E/$DA/                {           MOV    DS,DX            }
  121.       $46/                    { MONO1:    INC    SI               }
  122.       $26/$8A/$1C/            {           MOV    BL,ES:[SI]       }
  123.       $89/$1D/                {           MOV    DS:[DI],BX       }
  124.       $47/                    {           INC    DI               }
  125.       $47/                    {           INC    DI               }
  126.       $E2/$F6/                {           LOOP   MONO1            }
  127.       $1F);                   { DONE:     POP    DS               }
  128. End;
  129.  
  130. { ======================================================================== }
  131. { NAME: Set_Cursor                  VERSION: 1.0   DATE: 27 January 1986   }
  132. { AUTHOR:                                                                  }
  133. { DESCRIPTION: Set the cursor size                                         }
  134. { INPUTS: The number of cursor lines to display (0 -7, 0-14)               }
  135. {                                                                          }
  136. { ======================================================================== }
  137. Procedure Set_Cursor (n: byte);
  138. Var regpak      : ifrec;
  139.     top, bottom : byte;
  140. Begin
  141.    If Mem[$0040:$0049] = 7 Then bottom := 13
  142.    Else bottom := 7;
  143.    regpak.ax:= $100;
  144.    If n <= bottom Then top := bottom - n + 1
  145.    Else top := 0;
  146.    regpak.cx := top shl 8 or bottom;
  147.    Intr($10,regpak)
  148. End;
  149.  
  150. { --------------------------------------------------------- }
  151. { ReadChar - Get a character from the keyboard. Returns an  }
  152. {    integer from 0 to 512. Double keys have 256 added to   }
  153. {    them, e.g., F1 (27 59) returns 315 (59 + 256)          }
  154. { --------------------------------------------------------- }
  155. function ReadChar: integer;
  156. Var
  157.    ch : char;
  158.  
  159. begin
  160.    Read(kbd,ch);
  161.    if ch = Chr(IFESC) then
  162.       if KeyPressed then
  163.       begin
  164.          Read(kbd,ch);
  165.          ReadChar := Ord(ch) + 256;
  166.          Exit;
  167.       end;
  168.    ReadChar := Ord(ch);
  169. end;
  170.  
  171. { --------------------------------------------------------- }
  172. { FindPos - find the next occurrence of a character with-   }
  173. {    in a string. Returns 0 if character not found.         }
  174. { --------------------------------------------------------- }
  175. Function FindPos(s : strg255; startpos : integer; direction : boolean): integer;
  176. Const
  177.    delimiters : set of char = [' ','/','\',':','-','.',',','_','='];
  178.  
  179. Var i : integer;
  180.     found : boolean;
  181.  
  182. begin
  183.    i := startpos;
  184.    found := False;
  185.    if (((startpos = 0) and (direction = False)) or
  186.        ((startpos = length(s)) and (direction = True))) then
  187.    begin
  188.       FindPos := startpos;
  189.       Exit;
  190.    end;
  191.    repeat
  192.       if direction then i := Succ(i)
  193.       else i := Pred(i);
  194.       if ((i = 0) or (i = length(s))) then found := True
  195.       else
  196.          if (s[i] in delimiters) then found := True;
  197.    until found;
  198.    FindPos := i;
  199. end;
  200.  
  201. { --------------------------------------------------------- }
  202. { StrConst - Return a string of length n filled with char-  }
  203. {    acter c.                                               }
  204. { --------------------------------------------------------- }
  205. function StrConst(c : char; n : integer) : strg80;
  206. Var
  207.   s : strg80;
  208. begin
  209.   if n < 0 then n := 0;
  210.   s[0] := Chr(n);
  211.   FillChar(s[1],n,c);
  212.   StrConst := s;
  213. end;
  214.  
  215. { --------------------------------------------------------- }
  216. { DispField - Display the field and position the cursor.    }
  217. { --------------------------------------------------------- }
  218. Procedure DispField(x,y,size,attr,pcol : integer; filler : char; ibuf : strg255);
  219. var
  220.    s : strg80;
  221.    regpack : ifrec;
  222.  
  223. begin
  224.    s := ibuf + StrConst(filler,size - Length(ibuf));
  225.    DispLine(x - 1,y - 1,attr,s); { Display the field }
  226.    regpack.ah := 2;
  227.    regpack.bx := 0;
  228.    regpack.dh := y - 1;
  229.    regpack.dl := x + pcol - 1;
  230.    Intr($10,regpack);            { Position the cursor }
  231.    Gotoxy(wherex,wherey);        { adjust for turbo windos }
  232. end;
  233.  
  234. { --------------------------------------------------------- }
  235. { InpFld - Get a field of characters. Upon return, keyval   }
  236. {    has the last character entered. Legal contains all the }
  237. {    legal characters. If legal is empty, all characters    }
  238. {    are legal. Ibuf is the string returned. Attr is the    }
  239. {    screen attributes to use for the field. x and y are    }
  240. {    the position on the display to get input. Size is the  }
  241. {    maximum size of the field. Option are the input        }
  242. {    options. Options are:                                  }
  243. {       []   = No options chosen                            }
  244. {       [1]  = Perform uppercase translation                }
  245. {       [2]  = Exit only if field full or Esc pressed       }
  246. {       [5]  = Exit from field if field is full.            }
  247. {       [6]  = Right justify field upon exit                }
  248. {       [7]  = Display and use initial value of ibuf.       }
  249. {              Otherwise ibuf will be emptied before use.   }
  250. {   Field Editing Keys are:                                 }
  251. {      Left arrow,                                          }
  252. {      Ctl-S        - Move one character left.              }
  253. {                                                           }
  254. {      Right arrow,                                         }
  255. {      Ctl-D        - Move one character right.             }
  256. {                                                           }
  257. {      Home,                                                }
  258. {      Ctl-A        - Move to the start of the field.       }
  259. {                                                           }
  260. {      End,                                                 }
  261. {      Ctl-F        - Move to the current end of the field. }
  262. {                                                           }
  263. {      Del,                                                 }
  264. {      Ctl-G        - Delete the char under the cursor.     }
  265. {                                                           }
  266. {      BackSpace    - Delete the char to the left of cursor.}
  267. {                                                           }
  268. {      Ctl-BackSpace- Delete the entire field.              }
  269. {                                                           }
  270. {      Ins          - Toggle insert/overwrite mode.         }
  271. {                                                           }
  272. {      Ctl-End      - Delete to the end of the line.        }
  273. {                                                           }
  274. {      Ctl-Left arw - Move left one word.                   }
  275. {                                                           }
  276. {      Ctl-Right arw- Move right one word.                  }
  277. {                                                           }
  278. {      To end field editing, use one of Enter, Esc, Tab,    }
  279. {      BackTab, Up arrow or Down arrow; or fill the field   }
  280. {      if option 5 is selected.                             }
  281. { --------------------------------------------------------- }
  282. procedure InpFld(var keyval: integer;
  283.                    var Legal : strg255;
  284.                    var ibuf  : strg255;
  285.                        attr  : Integer;
  286.                        x,y,size : Integer;
  287.                        filler : char;
  288.                        option: option_type);
  289. Var
  290.   pcol   : integer;
  291.   ich : integer;
  292.   s   : strg80;
  293.   insmode : boolean;
  294.  
  295. begin
  296.   insmode := False;
  297.   if option >= [7] then else ibuf := '';
  298.   pcol := 0;
  299.   repeat
  300.      DispField(x,y,size,attr,pcol,filler,ibuf);
  301.      ich := ReadChar;
  302.      case ich of
  303.      32..126   : begin
  304.                     if option >= [1] then ich := Ord(Upcase(Chr(ich)));
  305.                     if ((Length(legal) = 0) or (Pos(Chr(ich),legal) <> 0)) then
  306.                     begin
  307.                        if pcol < size then
  308.                        begin
  309.                          if ((insmode) and (Length(ibuf) < size)) then
  310.                          begin
  311.                             pcol := Succ(pcol);
  312.                             Insert(Chr(ich),ibuf,pcol);
  313.                          end
  314.                          else
  315.                             if ((pcol < size) and (insmode = False)) then
  316.                             begin
  317.                                pcol := Succ(pcol);
  318.                                ibuf[pcol] := Chr(ich);
  319.                                if length(ibuf) < pcol then ibuf[0] := Chr(pcol);
  320.                             end;
  321.                        end;
  322.                     end;
  323.                  end;
  324.       IFCTLS,IFLARW : if pcol > 0 then   { left arrow }
  325.                          pcol := Pred(pcol);
  326.       IFCTLD,IFRARW : if pcol < Length(ibuf) then  { right arrow }
  327.                          pcol := Succ(pcol);
  328.       IFCTLA,IFHOME : pcol := 0;              { home }
  329.       IFCTLF,IFEND  : pcol := Length(ibuf);   { end }
  330.       IFCTLG,IFDEL  : if pcol < Length(ibuf) then    { del }
  331.                          begin
  332.                            Delete(ibuf,pcol + 1,1);
  333.                          end;
  334.       IFBKSP        : if pcol > 0 then        { backspace }
  335.                          begin
  336.                            Delete(ibuf,pcol,1);
  337.                            pcol := Pred(pcol);
  338.                       end;
  339.       IFCTBS        : begin               { delete line }
  340.                          ibuf := '';
  341.                          pcol := 0;
  342.                       end;
  343.       IFINS         : begin
  344.                          insmode := not insmode;
  345.                          if insmode then Set_Cursor(5)
  346.                          else Set_Cursor(2);
  347.                       end;
  348.       IFCEND        : Delete(ibuf,pcol+1,(length(ibuf)-pcol));
  349.       IFCRAR        : pcol := FindPos(ibuf,pcol,True);
  350.       IFCLAR        : pcol := FindPos(ibuf,pcol,False);
  351.     end;  {of case}
  352.     if ((option >= [2]) and (Length(ibuf) < size) and (ich <> IFESC)) then
  353.        ich := 0;
  354.   until ((ich = IFCR) or (ich = IFESC) or (ich = IFTAB) or (ich = IFBTAB) or
  355.      (ich = IFUARW) or (ich = IFDARW) or
  356.      ((option >= [5]) and (Length(ibuf) = size)));
  357.   pcol := Length(ibuf);
  358.   if option >= [6] then
  359.      s := StrConst(' ',size - Length(ibuf)) + ibuf
  360.   else
  361.      s := ibuf + StrConst(' ',size - Length(ibuf));
  362.   DispLine(x-1,y-1,attr,s);
  363.   keyval := ich;
  364.   Set_Cursor(2);
  365. end;
  366.